home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / tex / mfrm240.zip / MM.BAS < prev    next >
BASIC Source File  |  1991-05-02  |  12KB  |  383 lines
  1. ' Source code for Mainframe Mania - version 2.4 May 1, 1991
  2.  
  3. DEFINT A-Z
  4. DIM BEG.COL(200),LEN.FIELD(200),NUM.DECIMALS(200),NEG.COUNT(200)
  5. DIM WRDS$(10),LastIn$(200),LastOut$(200)              '2.4
  6.  
  7. '          -------------[ Subprograms ]--------------
  8. SUB TRAILSIGN (FIELD.TO.EDIT$,TRAIL.SIGN) STATIC
  9.  
  10. TRAIL.SIGN = 0
  11. TRAILING.SIGN$ = RIGHT$(FIELD.TO.EDIT$,1)
  12. K = INSTR(" +-",TRAILING.SIGN$)                        '092987
  13. IF K < 1 THEN EXIT SUB
  14. X$ = "X" + FIELD.TO.EDIT$
  15. L = LEN(FIELD.TO.EDIT$)
  16. J = L
  17. WHILE INSTR("0123456789",MID$(X$,J,1)) <> 0
  18.    J = J - 1
  19. WEND
  20. IF J = L THEN EXIT SUB
  21. TRAIL.SIGN = -1
  22. MID$(FIELD.TO.EDIT$,J+1) = MID$(FIELD.TO.EDIT$,J)
  23. MID$(FIELD.TO.EDIT$,J,1) = MID$("  -",K,1)             '092987
  24.  
  25. END SUB
  26.    
  27. SUB OVERSTRIKE (FLD$,SIGN.OF.NUM,WHETHER.CONVERTED) STATIC
  28. ' locate 20,1:print "overstrike got: ";fld$
  29. WHETHER.CONVERTED = 0
  30. SIGN.OF.NUM = 1
  31. LAST.CHAR$ = RIGHT$(FLD$,1)
  32. IF INSTR("0123456789",LAST.CHAR$) > 0 THEN _
  33.    EXIT SUB
  34. WHETHER.CONVERTED = -1
  35. X = INSTR("{ABCDEFGHI}JKLMNOPQR:",LAST.CHAR$) + 1
  36. IF X > 11 THEN SIGN.OF.NUM = -1
  37. LAST.CHAR$ = MID$("0012345678901234567890",X,1)
  38. MID$(FLD$,LEN(FLD$),1) = LAST.CHAR$
  39. END SUB
  40.  
  41. SUB FIRSTNB (STRNG$,BEG%,WHEREIS%) STATIC
  42.  
  43. REM PASS STRNG$  - A STRING TO BE SEARCHED
  44. REM      BEG%     - POSITION TO BEGIN SEARCH
  45. REM GET  WHEREIS% - POSITION IN STRNG$ OF FIRST NON-BLANK AT
  46. REM                  BEG% OR LATER.  RETURNS 0 IF NO NON-BLANK.
  47.  
  48. REM LOCATE 24,70:PRINT "FIRSTNB  ";
  49. X$ = STRNG$+"!"
  50. WHEREIS% = BEG%
  51. IF WHEREIS% < 1 THEN WHEREIS% = 1
  52. WHILE MID$(X$,WHEREIS%,1) = " "
  53.    WHEREIS% = WHEREIS% + 1
  54. WEND
  55. IF WHEREIS% > LEN(STRNG$) THEN WHEREIS% = 0
  56.  
  57. END SUB
  58.  
  59. SUB LASTNB (STRNG$,BEG%,WHEREIS%) STATIC
  60.  
  61. REM PASS STRNG$   - A STRING TO BE SEARCHED
  62. REM      BEG%      - POSITION TO BEGIN SEARCH
  63. REM GET  WHEREIS%  - LAST POSITION IN STRNG$ OF ANY WORD BEGINNING AT
  64. REM                   BEG% OR LATER.  RETURNS BEG%-1 IF NO WORD AT BEG%.
  65.  
  66. REM LOCATE 24,70:PRINT "LASTNB  ";
  67. B = BEG
  68. IF B < 1 THEN B = 1
  69. IF B > LEN(STRNG$) THEN_
  70.    X$ = " " _
  71. ELSE_
  72.    X$ = MID$(STRNG$,B)+" "
  73. WHEREIS% = INSTR(X$," ") - 1 + B - 1
  74.  
  75. END SUB
  76.  
  77. SUB BRKWORDS (STRNG$,WORDS$(1)) STATIC
  78.  
  79. REM PASS STRNG$  - A STRING TO BE BROKEN INTO WORDS (SPACE
  80. REM                 DELIMITED STRINGS)
  81. REM      WORDS$  - AN ARRAY TO PUT WORDS IN
  82.  
  83. ONE = 1
  84. LST = LEN(STRNG$)
  85. X$ = STRNG$ + " !"
  86. CALL FIRSTNB(X$,ONE,BS)
  87. NPARMS = 0
  88. MAXPARMS = 10 ' UBOUND(WORDS$)
  89. WHILE BS <= LST
  90.   NPARMS = NPARMS + 1
  91.   CALL LASTNB (X$,BS,ES)
  92.   IF NPARMS > MAXPARMS THEN _
  93.      BS = LST+1_
  94.   ELSE_
  95.      WORDS$(NPARMS) = MID$(X$,BS,ES-BS+1):_
  96.      BS = ES+1:_
  97.      CALL FIRSTNB(X$,BS,BS)
  98. WEND
  99. 'for i=1 to nparms:print "<";words$(i);">":next
  100. I = 1
  101. WHILE I <= NPARMS
  102.    IF INSTR(WORDS$(I),"/") > 0 THEN _
  103.      FOR J = I TO NPARMS-1 : _
  104.         WORDS$(J) = WORDS$(J+1): _
  105.      NEXT : _
  106.      WORDS$(NPARMS) = "" : _
  107.      NPARMS = NPARMS - 1 _
  108.    ELSE _
  109.      I = I + 1
  110. WEND
  111. 'print "/: ";:for i=1 to nparms: print "<";words$(i);">":next
  112. 'INPUT XX$
  113. END SUB
  114.  
  115. SUB TRIMLEFT (STRNG$) STATIC
  116.  
  117. WHILE LEFT$(STRNG$,1)=" "
  118.    STRNG$=MID$(STRNG$,2)
  119. WEND
  120.  
  121. END SUB
  122.  
  123. SUB CONVSCI (STRNG$) STATIC
  124.  
  125. J = INSTR(STRNG$,"E")
  126. IF J < 1 THEN EXIT SUB
  127. IF J = LEN(STRNG$) THEN EXIT SUB
  128. Y$ = LEFT$(STRNG$,J-1)
  129. MOVE.DEC = VAL(MID$(STRNG$,J+1))
  130. IF MOVE.DEC = 0 THEN STRNG$ = Y$ : EXIT SUB
  131.  
  132. CALL TRIMLEFT (Y$)
  133. IF LEFT$(Y$,1) = "-" THEN
  134.    SIGN.FIELD$ = "-"
  135.    Y$ = MID$(Y$,2)
  136. ELSE
  137.    SIGN.FIELD$ = ""
  138. END IF
  139. K = INSTR(Y$,".")
  140. IF K = 0 THEN K = LEN(Y$)+1 : Y$ = Y$+"."
  141. CHAR.RIGHT = LEN(Y$) - K
  142. CHAR.RIGHT$ = RIGHT$(Y$,CHAR.RIGHT)
  143. CHAR.LEFT = LEN(Y$) - 1 - CHAR.RIGHT
  144. CHAR.LEFT$ = LEFT$(Y$,CHAR.LEFT)
  145. ' PRINT "<";CHAR.LEFT$;"-";CHAR.RIGHT$;">"
  146. ' input xxx$
  147. IF MOVE.DEC > 0 THEN
  148.    IF CHAR.RIGHT < MOVE.DEC THEN
  149.       CHAR.RIGHT$ = CHAR.RIGHT$ + STRING$(MOVE.DEC-CHAR.RIGHT,"0")
  150.    END IF
  151.    CHAR.RIGHT$ = LEFT$(CHAR.RIGHT$,MOVE.DEC) + "." + RIGHT$(CHAR.RIGHT$,LEN(CHAR.RIGHT$)-MOVE.DEC)
  152. ELSE
  153.    IF CHAR.LEFT < -MOVE.DEC THEN
  154.       CHAR.LEFT$ = STRING$(-MOVE.DEC-CHAR.LEFT,"0") + CHAR.LEFT$
  155.    END IF
  156.    CHAR.LEFT$ = LEFT$(CHAR.LEFT$,LEN(CHAR.LEFT$)+MOVE.DEC) + "." + RIGHT$(CHAR.LEFT$,-MOVE.DEC)
  157. END IF
  158. ' LOCATE 17,1:PRINT "<";STRNG$;"> converted to <";sign.field$;char.left$;char.right$;">   ";
  159. ' input xxx$
  160. STRNG$ = SIGN.FIELD$ + CHAR.LEFT$ + CHAR.RIGHT$
  161. K = INSTR(STRNG$,".")                             ' 2.3
  162. I = LEN(STRNG$)                                   ' 2.3
  163. WHILE I > K AND RIGHT$(STRNG$,1) = "0"            ' 2.3
  164.    I = I - 1                                      ' 2.3
  165.    STRNG$ = LEFT$(STRNG$,I)                       ' 2.3
  166. WEND                                              ' 2.3
  167. END SUB
  168.  
  169. '    ---------------[  main program   ]---------------
  170. ON ERROR GOTO 1010
  171. X$ = COMMAND$
  172. I = (INSTR(X$,"/B") > 0)
  173. J = (INSTR(X$,"/b") > 0)
  174. RUN.BATCH = (I OR J)
  175. I = (INSTR(X$,"/T") > 0)
  176. J = (INSTR(X$,"/t") > 0)
  177. SINGLE.STEP = (I OR J) AND NOT RUN.BATCH
  178. ' SINGLE.STEP = -1
  179. CALL BRKWORDS (X$,WRDS$())
  180.  
  181. IF WRDS$(1) <> "" THEN _
  182.   FILE.TO.EDIT$ = WRDS$(1)_
  183. ELSE_
  184.   FILE.TO.EDIT$ = "MM.ZON"
  185. IF WRDS$(2) <> "" THEN_
  186.   FILE.TO.OUTPUT$ = WRDS$(2)_
  187. ELSE_
  188.   FILE.TO.OUTPUT$ = "MM.DMZ"
  189. IF WRDS$(3) <> "" THEN_
  190.   FILE.OF.CONV$ = WRDS$(3)_
  191. ELSE_
  192.   FILE.OF.CONV$ = "CONV.TBL"
  193.  
  194. 100 CLS
  195. LOCATE 1,2
  196. PRINT "Mainframe Mania 2.4 (05-01-91) QB - A Conversion Utility for Mainframe Data" '2.2
  197. LOCATE 2,22                                       ' 2.2
  198. PRINT "(c) 1987-91 by Ken Goosens"              ' 2.4
  199. LOCATE 4,10
  200. PRINT "Format:  MM[/B/T]  <source data>  <output file>  <how convert>"
  201. LOCATE 6,6
  202. PRINT "File to convert: ";FILE.TO.EDIT$
  203. LOCATE 6,43
  204. PRINT "Output to: ";FILE.TO.OUTPUT$
  205. LOCATE 8,20
  206. PRINT "Using conversion table: ";FILE.OF.CONV$
  207.  
  208. LOCATE 18,20
  209. IF NOT RUN.BATCH THEN INPUT "<C>ancel or <R>un? [ENTER = R] ",ANS$
  210. IF ANS$ <> "" THEN _
  211.   IF INSTR("Rr",LEFT$(ANS$,1)) < 1 THEN END
  212. ST# = TIMER
  213. LOCATE 18,1:PRINT SPACE$(79);
  214.  
  215. ON ERROR GOTO 900
  216. OPEN FILE.OF.CONV$ FOR INPUT AS #1
  217. ON ERROR GOTO 950
  218. INPUT #1,DATA.LEN,REC.DELIMITOR$
  219. ' print "data len=";data.len;" len delimiter=";len(rec.delimitor$)
  220. LEN.REC.DELIMITOR = LEN(REC.DELIMITOR$)            ' 2.3
  221. REC.LEN = DATA.LEN + LEN.REC.DELIMITOR             ' 2.3
  222. FIELDS.TO.CONVERT = 0
  223. WHILE NOT EOF(1)
  224.    FIELDS.TO.CONVERT = FIELDS.TO.CONVERT + 1
  225.    INPUT #1,BEG.COL(FIELDS.TO.CONVERT),_
  226.             LEN.FIELD(FIELDS.TO.CONVERT),_
  227.             NUM.DECIMALS(FIELDS.TO.CONVERT)
  228. WEND
  229. ' for i=1 to fields.to.convert:print beg.col(i),len.field(i),num.decimals(i):next
  230. CLOSE 1
  231.  
  232. ON ERROR GOTO 1000
  233. OPEN FILE.TO.EDIT$ FOR INPUT AS #1
  234. ON ERROR GOTO 1010
  235. CLOSE 1
  236. OPEN "R",1,FILE.TO.EDIT$,REC.LEN
  237. NUM.RECS# = LOF(1)
  238. NUM.RECS = INT(NUM.RECS#/REC.LEN)
  239. FIELD 1, DATA.LEN AS A$, _                      ' 2.3
  240.          LEN.REC.DELIMITOR AS A.DELIMITOR$      ' 2.3
  241. IF FILE.TO.OUTPUT$ = FILE.TO.EDIT$ THEN _
  242.    FILE.TO.OUTPUT$ = "MM.($)"
  243. OPEN FILE.TO.OUTPUT$ FOR OUTPUT AS #2
  244. LINE.READ = 0
  245. LOCATE 11,20
  246. PRINT "# records to process:";NUM.RECS;
  247. LOCATE 14,20
  248. PRINT "Processing record #";
  249. IF SINGLE.STEP THEN _
  250.    LOCATE 15,20 : _
  251.    PRINT "Processing field: "; : _
  252.    LOCATE 16,20 : _
  253.    PRINT "    Converted to: ";
  254. FOR LINES.READ = 1 TO NUM.RECS
  255.    GET 1,LINES.READ
  256.    IF A.DELIMITOR$ <> REC.DELIMITOR$ THEN     ' 2.3
  257.       IF LINES.READ < NUM.RECS THEN           ' 2.3
  258.          LOCATE 15,10                                         ' 2.3
  259.          PRINT "Improper record delimitor encountered on record";LINES.READ;  '2.3
  260.          LOCATE 16,10                                         ' 2.3
  261.          PRINT "Aborting.  Bad record is";                    ' 2.3
  262.          LOCATE 17,1                                          ' 2.3
  263.          PRINT A$                                             ' 2.3
  264.          END                                                  ' 2.3
  265.       END IF                                                  ' 2.3
  266.    END IF                                                     ' 2.3
  267.    LOCATE 14,40
  268.    PRINT LINES.READ;
  269.    NEXT.COL = 1
  270.    FOR I = 1 TO FIELDS.TO.CONVERT
  271.       IF NEXT.COL < BEG.COL(I) THEN _
  272.          PRINT #2,MID$(A$,NE